Responsible Impact (ReAct) is a participatory exercise at the Department of Communication and Psychology that seeks to develop and explore the department’s impact ecosystem. By staff engagement and iterative focus groups, the project collects and assesses annotated real-time data based on registration of impact activities (knowledge dissemination, pathways and linkages) by researchers at the Department of Communication and Psychology at Aalborg University.
By applying a rich and comprehensive impact taxonomy developed by interactive feedback from researchers at the department combined with a user-friendly web-based registration interface, the project aims to capture the diverse impact profiles of the department’s heterogeneous research groups while at the same time allowing researchers to have significant influence on how their impact is represented and communicated.
This websites presents some of the project outcomes as interactive visualizations.
---
title: "ReAct // Data Analytics Dashboard"
output:
flexdashboard::flex_dashboard:
theme: bootstrap
vertical_layout: scroll
social: menu
source: embed
---
```{r setup, include=FALSE,echo = FALSE,warning=FALSE}
library(flexdashboard)
require(tidyverse)
require(forcats)
require(tidytext)
require(silgelib)
require(ggthemes)
require(hrbrthemes)
require(patchwork)
require(scales)
require(plotly)
require(d3heatmap)
require(RColorBrewer)
require(sunburstR)
firstup <- function(x) {
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
x
}
all_data_final <- read_csv("201201_all_data_final.csv")
#23.7.2021
# now we can actually use the final_data_210720
# which includes wegener and øhstrøm
#final_data_210720 <- read_delim("final_data_210720.csv",
# ";", escape_double = FALSE, trim_ws = TRUE)
#all_data_final <-
#load the user_ids
user_ids_final <- read_csv("user_ids_final.csv")
#now lets modfiy it accordingly
# accordingto Louise2 the following need to go
filter_users<-c('Dollerup, Sanne','Dahlstedt, Mats Palle','Glintborg, Chalotte',
'Larsen, Malene Charlotte','Lykke, Marianne')
add_missing_users<-tibble(vivo_id=c(NA,NA),
name=c('Øhrstrøm, Peter','Wegener, Charlotte'),
position=c('professor','associateprofessor'),
vbn_id=c(NA,NA),pure_id=c(NA,NA))
user_ids_final%>%
filter(!name%in%filter_users)%>%
bind_rows(add_missing_users)->user_ids_final
#load the pure infos i.e. vbn downloads, avg bfi etc.
pure_bfi_complete <-read_csv('pure_bfi_complete.csv')
all_data_final%>%
pivot_longer(cols = -user_name,
names_to = 'category',values_to='count')%>%
left_join(user_ids_final%>%
select(name,position),
by=c('user_name'='name'))%>%
mutate(count=ifelse(is.na(count),
0,count))->all_data_final_long
all_data_final_long%>%
mutate(category = str_replace(category,pattern = '_',replacement = ' - '))%>%
separate(category,into = c('category','B'),sep = ' - ')%>%
mutate(B = firstup(B))%>%
unite(col = category,category,B,sep = ' - ')%>%
mutate(category = firstup(category))%>%
filter(!is.na(position))->all_data_final_long
#can only be loaded here after all_data_final_long is done
source('helpers_new.R')
all_data_final_long%>%
mutate(count=ifelse(count>0,1,0))%>%
group_by(category)%>%
summarise(category_total=(sum(count)/n_distinct(user_name)))%>%
mutate(top_category=case_when(
category%in%ParticipationInPerson ~'ParticipationInPerson',
category%in%ParticipationByProxy ~'ParticipationByProxy',
category%in%Inflow ~'Inflow'))%>%
mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
'ParticipationByProxy','Inflow')),
category=as.factor(category))%>%
mutate(category= reorder_within(category,
category_total,top_category))->taxonomy_plots
```
Background {data-icon="fa-book-open"}
================================
[Responsible Impact (ReAct) is a participatory exercise at the Department of Communication and Psychology](https://www.communication.aau.dk/research/Research+Projects/react/) that seeks to develop and explore the department's impact ecosystem. By staff engagement and iterative focus groups, the project collects and assesses annotated real-time data based on registration of impact activities (knowledge dissemination, pathways and linkages) by researchers at the Department of Communication and Psychology at Aalborg University.
By applying a rich and comprehensive impact taxonomy developed by interactive feedback from researchers at the department combined with a user-friendly web-based registration interface, the project aims to capture the diverse impact profiles of the department’s heterogeneous research groups while at the same time allowing researchers to have significant influence on how their impact is represented and communicated.
This websites presents some of the project outcomes as interactive visualizations.
Taxonomy Usage {data-icon="fa-bars"}
================================
Column {.tabset}
-----------------------------------------------------------------------
### All {data-height=1200}
```{r}
taxonomy_plots%>%ggplot(mapping=aes(x=category,y=category_total,
fill=top_category))+
geom_col(aes(text=paste('Percentage:',
round(category_total*100,2))))+coord_flip()+
scale_fill_manual(values = cols)+
scale_y_continuous(labels = percent)+
scale_x_reordered()+
theme_minimal()+
labs(x='',y='Percentage of Participants',
fill='',title='')+
theme(axis.text.y = element_text(size=7))->taxonomy_usage_all
ggplotly(taxonomy_usage_all,tooltip = c('text'))%>%
layout(legend = list(orientation = "h",x = 0, y = -0.1))
```
### Participation in Person
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Person'))%>%
ggplot(mapping=aes(x=category,y=category_total,
fill=top_category))+
geom_col()+coord_flip()+
scale_fill_manual(values = cols)+
scale_y_continuous(labels = percent)+
scale_x_reordered()+
theme_minimal()+
labs(x='',y='Percentage of Participants',
fill='',title='')+
theme(axis.text.y = element_text(size=7))->taxonomy_usage_person
ggplotly(taxonomy_usage_person)
```
### Participation by Proxy
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Proxy'))%>%
ggplot(mapping=aes(x=category,
y=category_total,
fill=top_category))+
geom_col()+coord_flip()+
scale_fill_manual(values = cols)+
scale_y_continuous(labels = percent)+
scale_x_reordered()+
theme_minimal()+
labs(x='',y='Percentage of Participants',
fill='',title='')+
theme(axis.text.y = element_text(size=7))->taxonomy_usage_proxy
ggplotly(taxonomy_usage_proxy)
```
### Inflow
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Inflow'))%>%
ggplot(mapping=aes(x=category,y=category_total,
fill=top_category))+
geom_col()+coord_flip()+
scale_fill_manual(values = cols)+
scale_y_continuous(labels = percent)+
scale_x_reordered()+
theme_minimal()+
labs(x='',y='Percentage of Participants',
fill='',title='')+
theme(axis.text.y = element_text(size=7))->taxonomy_usage_inflow
ggplotly(taxonomy_usage_inflow)
```
### Inputs {.sidebar}
-------------------------------------
Bla bla bla
Demographics {data-icon="fa-users"}
=====================================
Row
-------------------------------------
### Participant Positions
```{r}
user_ids_final%>%
group_by(position)%>%
count()%>%ungroup%>%
mutate(total=sum(n),percentage=n/total)%>%
ggplot(aes(x=reorder(position,percentage),y=percentage))+
geom_col(aes(text=paste('Percentage:',
round(percentage*100,2),'\nCount:',n)))+
coord_flip()+
scale_y_continuous(labels = percent)+
labs(x='',y='Percentage of Participants',
fill='',title='')+theme_minimal()->demo_position
ggplotly(demo_position,tooltip = c('text'))
```
### Testi 1
```{r}
```
Row
---------------------------------------
### Relative Contribution Per Category by Position
```{r}
all_data_final_long%>%
mutate(count=ifelse(count>0,1,0))%>%
mutate(top_category=case_when(
category%in%ParticipationInPerson ~'ParticipationInPerson',
category%in%ParticipationByProxy ~'ParticipationByProxy',
category%in%Inflow ~'Inflow'))%>%
mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
'ParticipationByProxy','Inflow')),
category=as.factor(category))%>%
group_by(position,top_category)%>%
summarise(total_count=sum(count))%>%
ggplot(aes(x=reorder(position,total_count),y=total_count,fill=top_category))+
geom_col()+coord_flip()+
scale_fill_manual(values = cols)+theme_minimal()+
labs(x='Position',
y='Total Contribution Per Top Category',fill='')->position_top_category_count
ggplotly(position_top_category_count)
```
### Testi 3
Cases {data-icon="fa-users"}
=====================================
```{r}
all_data_final_long%>%mutate(top_category=case_when(
category%in%ParticipationInPerson ~'ParticipationInPerson',
category%in%ParticipationByProxy ~'ParticipationByProxy',
category%in%Inflow ~'Inflow'))%>%
mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
'ParticipationByProxy','Inflow')))%>%
mutate(category = str_remove(category,'Inflow - '))%>%
mutate(helper = str_remove(category,' - '))%>%
mutate(category = sub(x = category,pattern = ' .*',replacement = ''))%>%
mutate(category = ifelse(category == helper,'Reference',category))%>%
mutate(category=as.factor(category))%>%
unite('sunburst_combo',c(top_category,category,helper),sep='-')%>%
mutate(sunburst_combo = str_remove_all(sunburst_combo,pattern =' '))%>%
select(user_name,V1=sunburst_combo,V2=count)->sunburst_data
tibble(
colors=c('blue','red','darkgreen',
rep('#5B5BFF',8),
rep('#B6B6FF',42),
rep('#FF5B5B',5),
rep('#FFB6B6',33),
rep('#008300',4),
rep('#C5FFC5',17)),
labels=c(c("ParticipationInPerson","ParticipationByProxy","Inflow"),
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='ParticipationInPerson')%>%pull(layer2)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='ParticipationInPerson')%>%pull(layer3)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='ParticipationByProxy')%>%pull(layer2)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='ParticipationByProxy')%>%pull(layer3)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='Inflow')%>%pull(layer2)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='Inflow')%>%pull(layer3)%>%unique))->color_tibble
```
Row
-------------------------------------
### Svend Brinkman
```{r}
sunburst_data%>%
filter(user_name=='Brinkmann, Svend')%>%
#mutate(V2=ifelse(V2>0,1,0))%>%
select(-user_name)%>%
sunburst(colors = list(range=color_tibble$colors,
domain=color_tibble$labels),legend=FALSE)
```
### Rikke Magnusen
```{r}
sunburst_data%>%
filter(user_name=='Magnussen, Rikke')%>%
#mutate(V2=ifelse(V2>0,1,0))%>%
select(-user_name)%>%
sunburst(colors = list(range=color_tibble$colors,
domain=color_tibble$labels),legend=FALSE)
```
Row
-------------------------------------
### Rikke Kristine Nielsen
```{r}
sunburst_data%>%
filter(user_name=='Nielsen, Rikke Kristine')%>%
#mutate(V2=ifelse(V2>0,1,0))%>%
select(-user_name)%>%
sunburst(colors = list(range=color_tibble$colors,
domain=color_tibble$labels),legend=FALSE)
```
### Music Therapy
```{r}
sunburst_data%>%
filter(user_name=='Ridder, Hanne Mette Ochsner')%>%
#mutate(V2=ifelse(V2>0,1,0))%>%
select(-user_name)%>%
sunburst(colors = list(range=color_tibble$colors,
domain=color_tibble$labels),legend=FALSE)
```
Analysis {data-icon="fa-cog"}
================================
Column {.tabset .tabset-fade}
-----------------------------------------------------------------------
### Heatmap {data-height=1200}
```{r}
top_5_each<-c('TeachingActivity - HigherEducation',
'FieldActivities - Meeting',
'AcademicEvent - Meeting',
'AcademicEvent - Seminar',
'AcademicEvent - Conference',
'AcademicProduct - Paper',
'AcademicProduct - Chapter',
'MediaProduct - ArticleJournalism',
'AcademicProduct - Manuscript','AcademicProduct - Abstract',
'Inflow - PopularMention','Inflow - PopularCitation',
'Request - Collaboration','Request - Advice','Request - Text')
all_data_final_long%>%filter(category%in%top_5_each)%>%
pivot_wider(names_from=category,values_from = count)%>%
select(-position)%>%column_to_rownames('user_name')->data_for_heatmap
d3heatmap(data_for_heatmap,
scale = 'column',
col = 'Blues',
na.color = 'Darkblue',
dendrogram = 'row',
k_row=4,
cexCol = 0.8,cexRow = 0.8,
height =900,width = 700,
labColSize = 200,labRowSize = 200)
```
### Activity Diversity Value
```{r}
#How diverse are participants in their activities
#i.e. among all possible
all_data_final_long%>%mutate(count = ifelse(count == 0,0,1))%>%
group_by(user_name,position)%>%
summarise(count_activities = sum(count),
total_cats=n(),
adv = count_activities/total_cats)%>%
mutate(position = firstup(position))%>%
ggplot(mapping = aes(x=position,y=adv))+
geom_violin(aes(color = position,
fill = position),alpha=0.6)+
geom_jitter(width = 0.2,
aes(color=position,fill=position,
text=paste('Participant: ',
user_name,'\nActivity Diversity Value: ',adv)))+
theme_minimal()+
labs(y='Activity Diversity Value',
x='',fill='',color='')->adv_plot
ggplotly(adv_plot,tooltip = c('text'))
```
### Activity Diversity vs. Total Publications
```{r}
all_data_final_long%>%mutate(count = ifelse(count == 0,0,1))%>%
group_by(user_name,position)%>%
summarise(count_activities = sum(count),
total_cats=n(),
adv = count_activities/total_cats)%>%
mutate(position = firstup(position))%>%
left_join(pure_bfi_complete,by=c('user_name'='author_name'))->react_pure_data
react_pure_data%>%
ggplot(aes(x=adv,y=publications_total))+
geom_point(aes(color=position,text=paste('Participant: ',user_name,
'\nActivity Diversity Value:',adv,
'\nTotal Publications:',publications_total)))+
geom_smooth()+theme_minimal()+
labs(x='Activity Diversity Value',y='Total Publications',color='')->adv_total_pubs
ggplotly(adv_total_pubs,tooltip = c('text'))
```
### Activity Diversity vs. Total BFI Points
```{r}
react_pure_data%>%
ggplot(aes(x=adv,y=total_bfi_points))+
geom_point(aes(color=position,text=paste('Participant: ',user_name,
'\nActivity Diversity Value:',adv,
'\nTotal BFI Points:',total_bfi_points)))+
geom_smooth()+theme_minimal()+
labs(x='Activity Diversity Value',y='Total BFI Points',color='')->adv_total_bfi
ggplotly(adv_total_bfi,tooltip = c('text'))
```
### Activity Diversity vs. Citations
```{r}
react_pure_data%>%
ggplot(aes(x=adv,y=citations_total_per_person))+
geom_point(aes(color=position,text=paste('Participant: ',user_name,
'\nActivity Diversity Value:',adv,
'\nTotal Citations:',citations_total_per_person)))+
geom_smooth()+theme_minimal()+
labs(x='Activity Diversity Value',y='Total Citations',color='')->adv_total_bfi
ggplotly(adv_total_bfi,tooltip = c('text'))
```
### Activity Diversity vs. Downloads
```{r}
react_pure_data%>%
ggplot(aes(x=adv,y=downloads_total_per_person))+
geom_point(aes(color=position,text=paste('Participant: ',user_name,
'\nActivity Diversity Value:',adv,
'\nTotal Downloads:',downloads_total_per_person)))+
geom_smooth()+theme_minimal()+
labs(x='Activity Diversity Value',y='Total Downloads',color='')->adv_total_bfi
ggplotly(adv_total_bfi,tooltip = c('text'))
```
### Inputs {.sidebar}
-------------------------------------
Bla bla bla